home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
130 MIDI Tool Box
/
130 MIDI Tool Box.iso
/
help
/
prog.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-04-27
|
2KB
|
99 lines
program Sendacommand;
{ ************************************************************** }
{ Program: Sendacommand }
{ Author : Jay Sissom }
{ Date : 4-26-88 }
{ Purpose: Send commands to the MPU }
{ ************************************************************** }
uses Crt;
const
Dataport = $330;
Comport = $331;
Statport = $331;
DSR = $80;
DRR = $40;
UART = $3F;
ACK = $FE;
RST = $FF;
THRU_ON = $89;
THRU_OFF = $88;
type
lstr = string[100];
var
X : integer;
j : char;
procedure send_command(cmd : byte);
var
stat : byte;
ackn : byte;
begin
ackn := 0;
while (ackn <> $FE) do
begin
stat := 0;
while (stat and DRR) = DRR do stat := port[Statport];
port[Comport] := cmd;
stat := 0;
while (stat and DSR) = DSR do stat := port[Statport];
ackn := port[Dataport]
end
end;
function send_data(d : byte) : boolean;
const
timeout = 255;
var
t : integer;
{ I added the timeout stuff because the program kept locking up }
{ bit 6 of Statport will never go to 0. It doesn't happen all }
{ the time. Usually the 2nd byte sent of the third run, when I }
{ tested it. }
begin
write('B ');
t := 0;
while ((Port[Statport] and DRR) = DRR) and (t < timeout) do inc(t);
if t = timeout
then send_data := false
else begin
port[Dataport] := d;
writeln('A')
end
end;
procedure error(msg : lstr);
begin
writeln;
writeln(msg);
halt(1)
end;
begin
send_command(RST);
send_command(UART);
FOR X := 50 to 70 do
begin
{ Send the data on Channel 2 }
if not send_data($91) then error('Timeout on note on');
if not send_data(X) then error('Timeout on on data');
if not send_data(10) then error('Timeout on on velocity');
delay(129);
if not send_data($91) then error('Timeout on note off');
if not send_data(X) then error('Timeout on off data');
if not send_data(0) then error('Timeout on off velocity')
end;
send_command(RST)
end.